The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/10/9/DISK1095.ZIP/PAYMNT.PRG

Text File | 1987-02-14 | 8KB | 234 lines

*
* PAYMNT
* ACCOUNTS PAYABLE FILE MAINTENANCE
* FILE STRUCTURE MUST ALREADY EXIST
SET HEADING OFF
SET SAFETY OFF
SET STATUS OFF
CLEAR
CLEAR ALL
SET TALK OFF
SET BELL OFF
* DEFINE A STRING OF BLANKS
STORE SPACE(80) TO BLANK
* CLEAR REQUEST AND ACTION CONTROL VARIABLES
STORE " " TO REQUEST
STORE " " TO ACTION
STORE "N" TO DATAIN
STORE 0 TO RECCNT
*
*===============================START MODS: 1================================*
* SET NAME OF FILE                                                           *
STORE "PAYFILE" TO FILENAME
* SETUP COUNT OF INDEXES FOR THE FILE filename
STORE 1 TO IXCOUNT
* SETUP CONSTANTS CONTAINING INDEXES IN SEQUENCE TO USE IN MACRO LATER.
* LIST EACH INDEX FIRST AS A PRIMARY INDEX. VARIABLES NAMED IXA, IXB, IXC, ETC.
STORE "PFACTNO" TO IXA
* DEFINE KEYS FOR INDEX. IF NUMERIC, MUST CONVERT WITH STR(). USE DI+IXA, ETC.
STORE "ACCT_NUM" TO DIIXA
*==================================END MODS==================================*
*
* SAVE NAME OF MACRO WHICH CONTAINS ACTIVE INDEX AS FIRST INDEX
STORE "IXA" TO LIVE_IX
* FIND RECORD COUNT
USE &FILENAME
COUNT TO RECCNT
*  IF DBF FILE IS ZAPPED, IF STATEMENT WILL PREVENT 'RECORD OUT OF RANGE'
*  ERROR FROM OCCURING WHEN <A>dd OPTION OF SUBMENU IS CHOSEN.
IF RECCNT = 1
   RECCNT = RECCNT-1
ENDIF
* IF FILE IS EMPTY, ASSUME INDEXES NOT CREATED AND CREATE THEM
   IF RECCNT = 0
   STORE 1 TO COUNT
   DO WHILE COUNT<=IXCOUNT
      STORE "IX"+CHR(64+COUNT) TO TEMP
      STORE "DI"+TEMP TO TEMP2
      IF IXCOUNT>1
         STORE SUBSTR(&TEMP,1,AT(",",&TEMP)-1) TO TEMP
      ELSE
         STORE &TEMP TO TEMP
      ENDIF
      STORE &TEMP2 TO TEMP2
      INDEX ON &TEMP2 TO &TEMP
      STORE COUNT+1 TO COUNT
   ENDDO
  ENDIF
* ADD INDEXES
SET INDEX TO &IXA
* POSITION AT FIRST RECORD IN LIVE INDEX SEQUENCE FOR INITIAL DISPLAY
GO TOP
*
* MAIN UPDATE LOOP. TERMINATED BY 'M' AS REQUEST
DO WHILE REQUEST<>"M"
*
*===============================START MODS: 2================================*
* DISPLAY SCREEN MASK: HEADING INFORMATION PLUS LABELS FOR EACH FIELD        *
   @ 1,22 SAY "SMITH'S BIKEWORKS INFORMATION SYSTEM"
   @ 3,20 SAY ">> Accounts Payable File Maintenance <<"
   @ 5,17 SAY "Today's Date:"
   ?? DATE()
* SETUP VARIABLE PART OF MASK
   CLEAR GETS
   @ 7,1  SAY "Account Number " GET ACCT_NUM
   @ 7,40  SAY "Date Recorded " GET DATE_RECD PICTURE "99/99/99"
   @  9,1  SAY "Payee      " GET PAYEE
   @ 11,1  SAY "Date Due   " GET DATE_DUE PICTURE "99/99/99"
   @ 11,40 SAY "Amount Due " GET AMOUNT PICTURE "99999.99"
   @ 13,1 SAY  "Date Paid  " GET DATE_PAID PICTURE "99/99/99"
   @ 13,40 SAY "Check Number " GET CHECK_NUM
   @ 15,1 SAY "Ref " GET REFERENCE
* DATE OF LAST UPDATE SHOULD BE ONE OF THE FIELDS (LAST_UPDT)
   @ 18,1 SAY "Last Updated : "
   ?? LAST_UPDT
*==================================END MODS==================================*
*
* DISPLAY VARIABLE DATA IN SCREEN HEADING
   IF DELETE()
      @ 5,1 SAY "* DELETED *"
   ELSE
      @ 5,1 SAY "           "
   ENDIF
* IDENTIFY RECORD
   @ 5,62 SAY RECCNT
   @ 5,50 SAY RECNO()
   @ 5,43 SAY "Record"
   @ 5,61 SAY "of"
* IF DATAIN FLAG SET, ACTIVATE THE GETS
   IF DATAIN="Y"
      @ 19,72 GET ACTION
      READ
* DATE STAMP RECORD
      REPLACE LAST_UPDT WITH DATE()
      IF REQUEST="E".OR.ACTION<>"C"
         STORE "N" TO DATAIN
         STORE " " TO REQUEST
         STORE " " TO ACTION
      ENDIF 2
   ELSE
      CLEAR GETS
   ENDIF 1
*
* DISPLAY CONTROL SUBMENU, CURRENT ACTIVE INDEX
   @ 19,0 SAY BLANK
   @ 20,0 SAY "----------------------------------------"
   @ 20,40 SAY "----------------------------------------"
   @ 21,0 CLEAR
   @ 21,2 SAY ;
"<F>ind Record  <A>dd Record   <D>elete/Recall  <E>dit Record   Current Active"
   @ 22,2 SAY ;
"<P>rev Record  <N>ext Record  <M>enu (return)  <K>ey Select    Key:          "
* IF INDEX SET NAMED IN LIVE_IX HAS MULTIPLE ENTRIES, EXTRACT FIRST
   IF (","$&LIVE_IX)
      STORE SUBSTR(&LIVE_IX,1,AT(",",&LIVE_IX)-1) TO TEMP
      @ 22,70 SAY TEMP
   ELSE
      @ 22,70 SAY &LIVE_IX
   ENDIF
* GET REQUEST AND FORCE TO UPPER CASE UNLESS ALREADY IN 'A' FOR ADD RECORDS
   IF REQUEST<>"A"
      STORE " " TO REQUEST
      STORE " " TO ACTION
      @ 23,10 SAY "          *** NEXT ACTION TO PERFORM " GET REQUEST
      READ
      STORE UPPER(REQUEST) TO REQUEST
   ENDIF
* CLEAR ADD RECORD COMMAND LINE, SUBMENU AREA
   @ 21,0 CLEAR
   DO CASE
* ADD NEW CASE OR EDIT DISPLAYED CASE
      CASE REQUEST="A".OR.REQUEST="E"
* IN ADD MODE, APPEND A BLANK RECORD FOR THE DATA AND POSITION TO THAT RECORD
         IF REQUEST="A"
            @ 19,6 SAY "*** PRESS 'C' TO CONTINUE ADDING NEW RECS, ANYTHING ;
ELSE TO QUIT"
            APPEND BLANK
            STORE RECCNT+1 TO RECCNT
            GO RECCNT
**PRESET DATE RECORDED TO TODAY'S DATE
            REPLACE DATE_RECD WITH DATE()
         ELSE
            @ 19,6 SAY "******** PRESS ANY KEY TO FINISH EDIT AND RETURN TO ;
SUBMENU     "
         ENDIF
         @ 21,10 SAY "Enter data at cursor position. Move among fields with"
         @ 22,10 SAY "cursor control keys. Press ENTER to move to next field."
         @ 23,10 SAY "Press ENTER alone to leave field unchanged."
* SET FLAG TO CAUSE NEW DATA TO BE READ
         STORE "Y" TO DATAIN
* TOGGLE DELETE FLAG. * FUNCTION CHECKS IF RECORD NOW FLAGGED AS DELETED
      CASE REQUEST="D"
         IF DELETE()
            RECALL
         ELSE
            DELETE
         ENDIF
* PREVIOUS RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="P"
         SKIP -1
* NEXT 3 LINES SECURE THE BACKWARD LOOP
         IF BOF()
            GO BOTTOM
         ENDIF
* NEXT RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="N"
         SKIP +1
* NEXT 3 LINES SECURE THE FORWARD LOOP
         IF EOF()
            GO TOP
         ENDIF
* GET SEARCH VALUE FOR INDEXED SEARCH
      CASE REQUEST="F"
* USE MACRO DEFINING INDEX ENTRIES FROM DATA FIELDS
         STORE "DI"+LIVE_IX TO IXDEF
         STORE &IXDEF TO SV
         STORE &SV TO SV
         @ 21,1 SAY ;
         "ENTER SEARCH VALUE. VALUE SHOWN IS FROM THE DISPLAYED RECORD. PRESS"
         @ 22,1 SAY "CTRL-Y TO CLEAR " GET SV
         READ
* IF RECORD IS NOT FOUND DISPLAY STAYS AT CURRENT RECORD
* NEXT LINE TO KEEP TRACK OF CURRENT RECNO() FOR TEST BELOW
         STORE RECNO() TO NOW
         SEEK SV
* NEXT 3 LINES KEEP PRESENT RECORD DISPLAYED IF NO FIND
         IF EOF()
            GOTO NOW
         ENDIF
* CHANGE INDEX
      CASE REQUEST="K"
         STORE RECNO() TO RECNOW
         STORE " " TO IXCHOICE
* SETUP MENU OF INDEX NAMES, PROVIDE IF CLAUSE FOR EACH INDEX                *
         @ 21,9 SAY " "
         STORE 1 TO COUNT
         DO WHILE COUNT<=IXCOUNT
            STORE "IX"+CHR(64+COUNT) TO TEMP
            IF IXCOUNT>1
               ?? CHR(64+COUNT)+". "+SUBSTR(&TEMP,1,AT(",",&TEMP)-1)+" "
            ELSE
               ?? CHR(64+COUNT)+". "+&TEMP
            ENDIF
            STORE COUNT+1 TO COUNT
         ENDDO
         @ 22,10 SAY "Press letter of desired key " GET IXCHOICE
         READ
         STORE UPPER(IXCHOICE) TO IXCHOICE
         IF IXCHOICE>="A".AND.IXCHOICE<=CHR(64+IXCOUNT)
            STORE "IX"+IXCHOICE TO LIVE_IX
            STORE &LIVE_IX TO TEMP
            SET INDEX TO &TEMP
         ENDIF
* GOTO THIS RECORD TO ACTIVATE INDEX
         IF RECNOW>0
            GO RECNOW
         ELSE
            GO BOTTOM
         ENDIF
   ENDCASE
ENDDO
* FALL OUT OF DO WHEN 'M' IS REQUEST, RETURN TO SUBSYSTEM'S MENU
CLEAR
RETURN